home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Devel / InnerPackage.pm next >
Encoding:
Perl POD Document  |  2009-06-26  |  2.4 KB  |  129 lines
  1. package Devel::InnerPackage;
  2.  
  3. use strict;
  4. use base qw(Exporter);
  5. use vars qw($VERSION @EXPORT_OK);
  6.  
  7. $VERSION = '0.3';
  8. @EXPORT_OK = qw(list_packages);
  9.  
  10. =pod
  11.  
  12. =head1 NAME
  13.  
  14.  
  15. Devel::InnerPackage - find all the inner packages of a package
  16.  
  17. =head1 SYNOPSIS
  18.  
  19.     use Foo::Bar;
  20.     use Devel::innerPackage qw(list_packages);
  21.  
  22.     my @inner_packages = list_packages('Foo::Bar');
  23.  
  24.  
  25. =head1 DESCRIPTION
  26.  
  27.  
  28. Given a file like this
  29.  
  30.  
  31.     package Foo::Bar;
  32.  
  33.     sub foo {}
  34.  
  35.  
  36.     package Foo::Bar::Quux;
  37.  
  38.     sub quux {}
  39.  
  40.     package Foo::Bar::Quirka;
  41.  
  42.     sub quirka {}
  43.  
  44.     1;
  45.  
  46. then
  47.  
  48.     list_packages('Foo::Bar');
  49.  
  50. will return
  51.  
  52.     Foo::Bar::Quux
  53.     Foo::Bar::Quirka
  54.  
  55. =head1 METHODS
  56.  
  57. =head2 list_packages <package name>
  58.  
  59. Return a list of all inner packages of that package.
  60.  
  61. =cut
  62.  
  63. sub list_packages {
  64.             my $pack = shift; $pack .= "::" unless $pack =~ m!::$!;
  65.  
  66.             no strict 'refs';
  67.             my @packs;
  68.             my @stuff = grep !/^(main|)::$/, keys %{$pack};
  69.             for my $cand (grep /::$/, @stuff)
  70.             {
  71.                 $cand =~ s!::$!!;
  72.                 my @children = list_packages($pack.$cand);
  73.     
  74.                 push @packs, "$pack$cand" unless $cand =~ /^::/ ||
  75.                     !__PACKAGE__->_loaded($pack.$cand); # or @children;
  76.                 push @packs, @children;
  77.             }
  78.             return grep {$_ !~ /::::ISA::CACHE/} @packs;
  79. }
  80.  
  81. ### XXX this is an inlining of the Class-Inspector->loaded()
  82. ### method, but inlined to remove the dependency.
  83. sub _loaded {
  84.        my ($class, $name) = @_;
  85.  
  86.     no strict 'refs';
  87.  
  88.        # Handle by far the two most common cases
  89.        # This is very fast and handles 99% of cases.
  90.        return 1 if defined ${"${name}::VERSION"};
  91.        return 1 if defined @{"${name}::ISA"};
  92.  
  93.        # Are there any symbol table entries other than other namespaces
  94.        foreach ( keys %{"${name}::"} ) {
  95.                next if substr($_, -2, 2) eq '::';
  96.                return 1 if defined &{"${name}::$_"};
  97.        }
  98.  
  99.        # No functions, and it doesn't have a version, and isn't anything.
  100.        # As an absolute last resort, check for an entry in %INC
  101.        my $filename = join( '/', split /(?:'|::)/, $name ) . '.pm';
  102.        return 1 if defined $INC{$filename};
  103.  
  104.        '';
  105. }
  106.  
  107.  
  108. =head1 AUTHOR
  109.  
  110. Simon Wistow <simon@thegestalt.org>
  111.  
  112. =head1 COPYING
  113.  
  114. Copyright, 2005 Simon Wistow
  115.  
  116. Distributed under the same terms as Perl itself.
  117.  
  118. =head1 BUGS
  119.  
  120. None known.
  121.  
  122. =cut 
  123.  
  124.  
  125.  
  126.  
  127.  
  128. 1;
  129.